COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "TEST"
C00005 ENDMK
C⊗;
BEGIN "TEST"

REQUIRE "ABRIV[MUS,TVR]" SOURCE_FILE;
REQUIRE "HALVES[1,TVR]" SOURCE_FILE;


INT PROC DPYCHR(INT CHAR,X,Y; SAFE INT ARRAY FONT,ROWTAB,COLTAB);
⊂ INT BYTES,ADR,Y0,WIDTH,INC,TMP,PTR1,PTR2;
COMMENT 

RETURNS:

0	Character successfully deposited.
1	No such character defined in the font.
2	Invalid font file.
3	X or Y out of range.
4	Would overflow in x direction if character deposited
5	Character too tall (would overflow in Y direction)
;
  IF FONT[CHAR]≤0 THEN RETURN(1);
  IF (ADR←HRRE(FONT[CHAR]))≥ARRINFO(FONT,2)∨
      ADR+HRRE(FONT[ADR])>ARRINFO(FONT,2)∨
      HRRE(FONT[ADR←HRRE(FONT[CHAR])])≠CHAR
    THEN RETURN(2);
  IF X<ARRINFO(COLTAB,1)∨X>ARRINFO(COLTAB,2)∨
      Y<ARRINFO(ROWTAB,1)∨Y>ARRINFO(ROWTAB,2)
    THEN RETURN(3);
  IF X+(WIDTH←HLRE(FONT[CHAR]))>ARRINFO(COLTAB,2) THEN RETURN(4);
  IF (Y0←Y-FONT['203]+HLRE(FONT[ADR+1]))<ARRINFO(ROWTAB,1) THEN RETURN(5);
  IF (BYTES←36%WIDTH)=0 THEN BYTES←1;
  PTR1←POINT(1,FONT[ADR+2],-1);
  PTR2←COLTAB[X]+ROWTAB[Y0]+'010000000000;
  INC←ROWTAB[Y0+1]-ROWTAB[Y0];
  TMP←HRRE(FONT[ADR+1]);
  S⊂ ACCUMULATORS({P1,P2,R,C,B,CNT});
	LABEL L1,L2,L3,L4;
	MOVE R,TMP;
	MOVE P1,PTR1;
	MOVE P2,PTR2;
	MOVE B,BYTES;
L1:	MOVE C,WIDTH;
L2:	ILDB 1,P1;
	ILDB 0,P2;
	IORI 0,(1);
	DPB 0,P2;
	JUMPG P2,L3;
	TLZ P2,'770000;
L3:	SOJG C,L2;
	MOVE P2,INC;
	ADDB P2,PTR2;
	SOJG B,L4;
	TLZ P1,'770000;
L4:	SOJG R,L1 ⊃;
  RETURN(0) ⊃;